home *** CD-ROM | disk | FTP | other *** search
/ Aminet 1 (Walnut Creek) / Aminet - June 1993 [Walnut Creek].iso / usenet / sources / volume90 / aplictns / xscheme2 / part01 / pi-calc.s < prev    next >
Text File  |  1990-04-14  |  578b  |  29 lines
  1. (define (pi-calc n)
  2.     (define (a n)
  3.         (if (zero? n)
  4.             1
  5.             (/ (+ (a (-1+ n))
  6.                   (b (-1+ n)))
  7.                2)))
  8.     (define (b n)
  9.         (if (zero? n)
  10.             (/ (sqrt 2))
  11.             (sqrt (* (a (-1+ n))
  12.                      (b (-1+ n))))))
  13.     (define (square x)
  14.         (* x x))
  15.     (define (two2theN n)
  16.         (if (zero? n)
  17.             1
  18.             (* 2 (two2theN (-1+ n)))))
  19.     (define (sumof start end func)
  20.         (let ((first (func start)))
  21.             (if (= start end)
  22.                 first
  23.                 (+ first (sumof (1+ start) end func)))))
  24.     (define (denom-func i)
  25.         (* (two2theN i)
  26.            (square (- (a i) (b i)))))
  27.     (/  (* 4 (a n) (b n))
  28.         (- 1 (sumof 0 (-1+ n) denom-func))))
  29.